﻿#VisualFreeBasic_Form#  Version=5.4.0
Locked=0

[Form]
Name=Form1
ClassStyle=CS_DBLCLKS,CS_HREDRAW,CS_VREDRAW
ClassName=
WinStyle=WS_CAPTION,WS_CLIPCHILDREN,WS_CLIPSIBLINGS,WS_MAXIMIZEBOX,WS_MINIMIZEBOX,WS_SYSMENU,WS_THICKFRAME,WS_VISIBLE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_EX_WINDOWEDGE,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=Form1
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=688
Height=365
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,0
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=Excel create get object
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=8
Top=220
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command2
Index=-1
Caption=Dll 免注册调用
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=151
Top=220
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command3
Index=-1
Caption=dll createobject(注)
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=297
Top=220
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[ListBox]
Name=List1
Index=-1
Custom=
Style=0 - 单选
BStyle=3 - 凹边框
OwnDraw=0 - 系统绘制
ItemHeight=15
HasString=False
Sorted=False
NoHeight=True
MultiColumn=False
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,5
Font=微软雅黑,9,0
Left=166
Top=10
Width=224
Height=198
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Button]
Name=Command4
Index=-1
Caption=Excel Event UnLoad
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=8
Top=257
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command5
Index=-1
Caption=调用COMtest(注)
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=299
Top=257
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command6
Index=-1
Caption=调用CAD
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=151
Top=257
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command7
Index=-1
Caption=测试本工程com dll(注)
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=9
Top=289
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command8
Index=-1
Caption=测试flash控件
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=153
Top=291
Width=139
Height=30
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command9
Index=-1
Caption=测试flash控件
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=447
Top=221
Width=135
Height=29
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command10
Index=-1
Caption=测试vb6 ocx(注)
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=447
Top=256
Width=133
Height=29
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command11
Index=-1
Caption=动态调用ocx
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=447
Top=290
Width=131
Height=29
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[Button]
Name=Command12
Index=-1
Caption=Active EXE动态调用
Enabled=True
Visible=True
Default=False
OwnDraw=False
MultiLine=False
Font=微软雅黑,9,0
Left=302
Top=289
Width=130
Height=32
Layout=0 - 不锚定
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False


[AllCode]
'这是标准的工程模版，你也可做自己的模版。
'写好工程，复制全部文件到VFB软件文件夹里【template】里即可，子文件夹名为 VFB新建工程里显示的名称
'快去打造属于你自己的工程模版吧。
'	VT_EMPTY = 0
'	VT_NULL = 1
'	VT_I2 = 2
'	VT_I4 = 3
'	VT_R4 = 4
'	VT_R8 = 5
'	VT_CY = 6
'	VT_DATE = 7
'	VT_BSTR = 8
'	VT_DISPATCH = 9
'	VT_ERROR = 10
'	VT_BOOL = 11
'	VT_VARIANT = 12
'	VT_UNKNOWN = 13
'	VT_DECIMAL = 14
'	VT_I1 = 16
'	VT_UI1 = 17
'	VT_UI2 = 18
'	VT_UI4 = 19
'	VT_I8 = 20
'	VT_UI8 = 21
'	VT_INT = 22
'	VT_UINT = 23
'	VT_VOID = 24
'	VT_HRESULT = 25
'	VT_PTR = 26
'	VT_SAFEARRAY = 27
'	VT_CARRAY = 28
'	VT_USERDEFINED = 29
'	VT_LPSTR = 30
'	VT_LPWSTR = 31
'	VT_RECORD = 36
'	VT_INT_PTR = 37
'	VT_UINT_PTR = 38
'	VT_FILETIME = 64
'	VT_BLOB = 65
'	VT_STREAM = 66
'	VT_STORAGE = 67
'	VT_STREAMED_OBJECT = 68
'	VT_STORED_OBJECT = 69
'	VT_BLOB_OBJECT = 70
'	VT_CF = 71
'	VT_CLSID = 72
'	VT_VERSIONED_STREAM = 73
'	VT_BSTR_BLOB = &hfff
'	VT_VECTOR = &h1000
'	VT_ARRAY = &h2000
'	VT_BYREF = &h4000
'	VT_RESERVED = &h8000
'	VT_ILLEGAL = &hffff
'	VT_ILLEGALMASKED = &hfff
'	VT_TYPEMASK = &hfff

Dim Shared pEvtObj As Workbook_WorkbookEvents 
Dim Shared WorkBook as IDispatch ptr
sub mOn_Attr2Changed(ByVal var1 As Double)
   MsgBox "事件："& Str(var1)
   
End Sub
Function On_Modified(ByRef pObject As Any Ptr) As HRESULT
   MsgBox "图元修改"
   Return 0
End Function

sub BeforeClose(ByRef Cancel As VARIANT_BOOL)
    Me.List1.AddItem "正要关闭"
End Sub

Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim v as VB , ret as VARIANT, p as VARIANT
   'dim o as IDispatch ptr = v.GetObject("excel.application") ' 两者都可以用
   dim Excel as IDispatch ptr = v.CreateObject("excel.application")
   p = CVAR(vbTrue)
   Dim hr As HRESULT = v.CallByName(Excel, "Visible", vbLet, @ret, 1, @p)
   hr = v.CallByName(Excel, "WorkBooks", vbget, @ret, 0, null)
   if hr <> 0 Then MsgBox "创建EXCEL失败" + Str(hr)
   Dim WorkBooks as IDispatch ptr = ret.pdispVal
   
   Dim filename As VARIANT
   filename=CVAR("C:\1.xlsx")
   hr = v.CallByName(WorkBooks, "Open", vbmethod, @ret, 1, @filename)
   
   'hr = v.CallByName(WorkBooks, "Add", vbmethod, @ret, 0,null)
   if hr <> 0 Then 
      MsgBox "创建工作薄失败" + Str(hr)
      Return 
   End if 

   WorkBook = ret.pdispVal

   'hr = v.CallByName(workBook, "ActiveSheet", vbget, @ret, 0)
   'if hr <> 0 Then MsgBox "创建工作薄失败" + Str(hr

   pEvtObj.On_BeforeClose = @BeforeClose

   hr = v.WithEvents(WorkBook, @pEvtObj)

   if hr <> 0 Then MsgBox "创建事件失败" + str(hr)

   p = CVAR("a1")
   hr = v.CallByName(Excel, "Range", vbget, @ret, 1, @p)
   if hr <> 0 Then MsgBox "第二步失败" + str(hr)
   Dim Range as IDispatch ptr = ret.pdispVal
   hr = v.CallByName(Range, "value", vblet, null, 1, @p)
   hr = v.CallByName(Range, "Address", vbget, @ret, 0,null)
   if hr <> 0 Then MsgBox hr
   MsgBox AfxVarToStr(@ret, True)
   'v.UnWithEvents(WorkBook, pEvtObj)
   v.FreeObject(Range)
   v.FreeObject(WorkBooks)
   v.FreeObject(Excel)
End Sub

Sub Form1_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim v as VB 
   dim o as IDispatch Ptr  
   dim ret as VARIANT, p(1) as VARIANT
   p(0) = cvar(3& )
   p(1) = cvar(4& )

   o = v.CreateObjectFromLib("demo.dll", "{41B2E62E-310E-4DDC-8A52-AC6497AEC31D}")
   'o = v.CreateObjectFromLib("comtest.dll", "{920DCEED-B3DD-4110-8F2F-981A554E07FF}")

   dim hr As HRESULT = v.CallByName(o, "Add", vbmethod, @ret, 2, @p(0))
   if hr <> 0 Then
      msgbox "调用函数失败"
   End If
   msgbox str(ret.lVal)
End Sub

Sub Form1_Command3_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim o as IDispatch ptr
   dim v as vb
   dim ret as VARIANT
   dim p(1) as VARIANT
   p(0) = cvar(3& )
   p(1) = cvar(4& )
   o = v.CreateObject("Demo.DemoClass") '需要注册dll
   if o = 0 Then Return
   dim hr As HRESULT = v.CallByName(o, "Add", vbmethod, @ret, 2, @p(0))
   if hr <> 0 then MsgBox str(hr)
   msgbox Str(ret.lVal)
   
End Sub

Sub Form1_Command4_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   if WorkBook=0 Then Return 
   dim v as vb
   v.UnWithEvents(WorkBook, @pEvtObj)
   v.FreeObject(WorkBook)
End Sub

Sub Form1_Command5_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim v as VB 
   dim o as IDispatch ptr
   dim ret as VARIANT, p(0) as VARIANT
   p(0) = cvar(3.3)
   o = v.CreateObjectFromLib("comtest.dll", CLSID_cCom)
   dim pEvtObjxx As cCom___cCom 
   pEvtObjxx.Attr2Changed=@mOn_Attr2Changed
   dim hr As HRESULT = v.WithEvents(o, @pEvtObjxx)
   
   hr = v.CallByName(o, "Attr2", vblet, @ret, 1, @p(0))
   hr = v.CallByName(o, "Attr2", vbget, @ret, 0, NULL)
   
   if hr <> 0 Then
      msgbox "调用函数失败"
   End If
   msgbox str(ret.dblVal)
End Sub
Function ppp3(ByVal a As Double, ByVal b As Double, ByVal c As Double) As VARIANT
   Dim v As cvar 
   Dim p(2) As Double={a,b,c}
   v.putDoubleArray(@p(0), 3)
   Return v.vd
End Function

Sub Form1_Command6_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim v as VB , ret as VARIANT, p as VARIANT
   Dim hr As HRESULT
   Dim doc As IDispatch Ptr
   Dim MSP As IDispatch Ptr
   Dim objCircle As IDispatch Ptr
   Dim param(1) As VARIANT
   Dim Ps(2) As Double = {0, 0, 0}
   Dim Pss(2) As Double = {1000, 1000, 0}
   Dim cadApp as IDispatch Ptr
   cadApp = v.GetObject("autocad.application")
   MsgBox "cadApp=" & cadApp
   if cadApp=0 Then Return 
   hr = v.CallByName(cadApp, "Name", vbGet, @ret, 0, null)
   MsgBox str(ret.bstrVal)
   hr = v.CallByName(cadApp, "ActiveDocument", vbGet, @ret, 0, null)
   MsgBox "ActiveDocument"
   doc = ret.pdispVal
   MsgBox "获得Doc"
   hr = v.CallByName(doc, "ModelSpace", vbGet, @ret, 0, null)
   MsgBox "ModelSpace"
   MSP = ret.pdispVal
   hr = v.CallByName(MSP, "Name", vbGet, @ret, 0, null)
   MsgBox str(ret.bstrVal)
   MsgBox "获得MSP"
   param(0) =ppp3(1000,0,0)
   param(1) =ppp3(0,0,0)

   hr = v.CallByName(MSP, "AddLine", vbMethod, @ret, 2, @param(0))
   dim pEvtObjxx As AcadObject_IAcadObjectEvents 
   pEvtObjxx.On_Modified = @On_Modified
   
   hr = v.WithEvents(ret.pdispVal, @pEvtObjxx)
   MsgBox "AddLine成功"
   objCircle = ret.pdispVal
End Sub

Sub Form1_Command7_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   dim v as VB 
   dim o as IDispatch ptr
   dim ret as VARIANT, p(1) as VARIANT
   p(0) = cvar(3& )
   p(1) = cvar(4& )
   o = v.CreateObjectFromLib("ComDemo.dll", "{920DCEED-B3DD-4110-8F2F-981A554E07FF}")
   DispCallFunc(o, 28, 1, vbVariant, 0, 0, 0, @ret)
   
   Dim c As VARIANT
   c=CVAR(NULL)
   dim hr As HRESULT = v.CallByName(o, "Add", vbmethod, @ret, 2, @p(0))
   if hr <> 0 Then
      msgbox "调用函数失败"
   End If
   msgbox str(ret.lVal)
End Sub

Sub Form1_Command8_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   test
End Sub

Sub Form1_Command9_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击

   Dim flash As IDispatch Ptr
   Dim v As VB ,ret as VARIANT,p(0) as VARIANT

   flash = v.CreateControl("{D27CDB6E-AE6D-11cf-96B8-444553540000}", 400, 0, 400, 400, Me.hWnd, App.hInstance)

   if flash = NULL Then MsgBox"出错了"
   p(0) = cvar("https://static.youku.com/v201803261000.0/v/swf/upsplayer/player_yknpsv.swf")

   v.CallByName(flash, "movie", vbLet, @ret, 1, @p(0))

   v.CallByName(flash, "movie", vbget, @ret, 0, null)
  
   MsgBox str(ret.bstrVal)
   v.CallByName(flash,"Play",vbMethod,NULL,0,null)'可能是链接比较慢，自己换地址研究

End Sub
Sub On_MyClickEvent()
   MsgBox "vb6回调"
End Sub

Sub Form1_Command10_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击

   Dim o As IDispatch Ptr
   Dim v As VB 
   Dim ret as VARIANT, p(1) as VARIANT

   o = v.CreateControl(CLSID_TestControl, 400, 0, 200, 100, Me.hWnd, App.hInstance)
   if o = NULL Then MsgBox"出错了"
   Static e As TestControl___TestControl  '必须保持变量，不然回调会崩溃
   e.On_MyClickEvent = @On_MyClickEvent
   v.WithEvents(o, @e)
   p(0) = cvar(123)
   p(1) = cvar(123)
   'v.CallByName(o, "Add", vbmethod, @ret, 2, @p(0))
   'DispCallFunc o, &H60030001,1
   'vb6弄出的ocx不知道为什么那么多[restricted] void Missing419();……把函数弄到最后去了，等明白人研究吧
   
End Sub

Sub Form1_Command11_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Dim v as vb 
   Dim ret as VARIANT, p(1) as VARIANT
   Dim o As Any Ptr = v.CreateObjectFromLib("Ocxp.ocx", CLSID_TestControl)
   
   v.AttachControl(o, Me.hWnd)
   Static e As TestControl___TestControl '必须保持变量，不然回调会崩溃
   e.On_MyClickEvent = @On_MyClickEvent
   v.WithEvents(o, @e)
   p(0) = cvar(123)
   p(1) = cvar(123)
   'v.CallByName(o, "Add", vbmethod, @ret, 2, @p(0))
   'DispCallFunc o, &H60030001,1
   'vb6弄出的ocx不知道为什么那么多[restricted] void Missing419();……把函数弄到最后去了，等明白人研究吧
End Sub

Sub Form1_Command12_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
   Dim v As vb, o As IDispatch Ptr, ret as VARIANT, para(1) As VARIANT
   o = v.CreateObject("testAxExe.AxExe") '
   if o=0 Then Return 
   para(0) = CVAR(123)
   para(1) = CVAR(24)
   v.CallByName(o, "add", vbmethod, @ret, 2, @para(0))
   if o <> NULL Then MsgBox Str(ret.lVal)
End Sub





















   